Traffic Count Analysis to Inform Model Validation

Permanent Traffic Count Stations in TRPA Region (2018)

map<-continuous %>% distinct(lat,lon, station)
  map %>%
  st_as_sf(coords=c("lon", "lat"), crs=4326) %>% 
  leaflet() %>% addTiles() %>% addMarkers(popup = paste(map$station))

Total Daily Totals

ggplotly(
  continuous %>% group_by(Day1) %>% 
    summarise(Count=sum(Count)) %>% ggplot(aes(Day1, Count)) + 
    geom_col() + theme_minimal()
  )

Hourly Count Distribution

ggplotly(
ggplot(data = continuous, aes(x = Count)) + 
   geom_histogram(aes(y=..density..),colour="black", fill="white") +
  geom_density(alpha=.2, fill="#FF6666") + ggtitle("Hourly Counts") +
   theme(axis.title.x = element_blank(), axis.text.y=element_blank(), axis.title.y=element_blank()) + theme_minimal()
)

Daily Count Distribution

ggplotly(
continuous %>% 
  group_by(Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>% 
  ggplot(aes(Count)) +
  geom_histogram(aes(y=..density..),colour="black", fill="white") +
  geom_density(alpha=.2, fill="#FF6666")  +
  theme_minimal() +
  theme(axis.title.x = element_blank(), axis.text.y=element_blank(), axis.title.y=element_blank()) +
  ggtitle("Daily Count Distribution") 
)

Daily Count Totals Count by Day of Week

all_days<- continuous %>% 
  group_by(weekday, Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>% 
  ungroup()

ggplotly(
  ggplot(all_days, aes(Day,Count, group=weekday, color=weekday)) + geom_line() + theme_minimal()) %>%
  layout(legend = list(orientation = "h", x = 0.0, y = -0.3)) 

Summary Statistics all Data

options(scipen=999)

ggplotly(
continuous %>%
  group_by(Day,month, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
ggplot(aes(x = weekday, y = Count, color = weekday)) +
  theme(axis.text.x=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), axis.ticks.x=element_blank()) +
  geom_boxplot(outlier.shape = NA) +
  facet_grid(~month) + theme(legend.position="bottom") + ggtitle("Traffic Counts") +
  scale_color_manual(values=c("#08D6DA", "#06378D", "#BE0B05", "#F7A537", "#DEF006", "#35AA27", "#940CD8")), height=800) %>%
  layout(legend = list(orientation = "h", x = 0.0, y = -0.2)) %>%
  style(legendgroup = NULL)

Median Daily Total Counts by Day of Week

ggplotly(
continuous %>% 
  group_by(weekday, month,Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>% 
  group_by(weekday, month) %>% 
  summarise(median_count=median(Count)) %>%
  ungroup() %>%
  ggplot(aes(month,median_count, group=weekday, color=weekday)) + geom_line(size=1) + theme_minimal() + 
  theme(legend.position="bottom", legend.title = element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank()) +
  scale_colour_manual(values=c("#08D6DA", "#06378D", "#BE0B05", "#F7A537", "#DEF006", "#35AA27", "#940CD8"))
)

Daily Count Distribution by Month of Year

options(scipen=999)

continuous %>%
  group_by(Day, month) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  ggplot(aes(x = Count, y = factor(month), fill=month)) +
  ggridges::geom_density_ridges(stat = "density", aes(height = stat(density))) +
  theme_minimal() + scale_fill_discrete() + 
  theme(axis.title.y = element_blank(), legend.position="none", axis.text.y=element_text(size=14), axis.text.x=element_text(size=14), axis.title.x=element_blank())

Median Daily Count by Month of Year

ggplotly(
continuous %>% 
  group_by(Day, month) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  group_by(month) %>%
  summarise(Count=median(Count)) %>% 
  ggplot(aes(month, Count)) + geom_col() + theme_minimal() +
   theme(legend.title = element_blank(), legend.position = 'bottom', axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.text.x=element_text(size=12)) 
)

Daily Count Distribution by Day of Week

options(scipen=999)
continuous %>%
  group_by(Day, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  ggplot(aes(x = Count, y = factor(weekday), fill=weekday)) +
  ggridges::geom_density_ridges(stat = "density", aes(height = stat(density))) +
  theme_minimal() + scale_fill_discrete() + 
  theme(axis.title.y = element_blank(), legend.position="none", axis.text.y=element_text(size=14), axis.text.x=element_text(size=14), axis.title.x=element_blank())

Median Daily Count by Day of Week

ggplotly(
continuous %>% 
  group_by(Day, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  group_by(weekday) %>%
  summarise(Count=median(Count)) %>% 
  ggplot(aes(weekday, Count)) + geom_col() + theme_minimal() +
   theme(legend.title = element_blank(), legend.position = 'bottom', axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.text.x=element_text(size=12)) 
)

Daily Count Distribution by Day of Week

Entry/Exit Station by Day of Week

ggplotly(
continuous %>% 
  filter(ext_int=="External Station") %>%
  group_by(Day, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>% 
  group_by(weekday) %>%
  summarise(Count=median(Count)) %>% 
  ggplot(aes(weekday, Count,)) + geom_col(fill="#06378D") + theme_minimal() +
  theme(legend.title = element_blank(), legend.position = 'bottom', axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.text.x=element_text(size=12)) 
)

Entry/Exit Station by Month

ggplotly(
continuous %>% 
  filter(ext_int=="External Station") %>%
  group_by(Day, month) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  group_by(month) %>%
  summarise(Count=median(Count)) %>%
  ggplot(aes(month, Count)) + geom_col() + theme_minimal() +
    scale_fill_manual(values=c("#08D6DA", "#06378D")) +
 theme(legend.title = element_blank(), legend.position = 'bottom', axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.text.x=element_text(size=12)) 
)